#ucitavanje paketa Učitajmo potrebne pakete
library(dplyr)
#Učitavanje podataka
Učitajmo podatke iz .csv file-a
bigFiveData = read.csv("../big_five_scores.csv")
dim(bigFiveData)
## [1] 307313 9
Podaci se sastoje od 307 313 testiranih ljudi i 9 varijabli koje promatramo.
Popis varijabli koje promatramo:
names(bigFiveData)
## [1] "case_id" "country"
## [3] "age" "sex"
## [5] "agreeable_score" "extraversion_score"
## [7] "openness_score" "conscientiousness_score"
## [9] "neuroticism_score"
Za testirane sudionike u tablici su navedeni njihovi podaci (godina, zemlja, spol) te 5 faktora koje promtramo(ekstraverzija, ugodnost, savjesnost, neuroticizam i otvorenost)
Možemo promotriti ponašanje varijabli.
summary(bigFiveData)
## case_id country age sex
## Min. : 1 Length:307313 Min. :10.00 Min. :1.000
## 1st Qu.: 83653 Class :character 1st Qu.:18.00 1st Qu.:1.000
## Median :166286 Mode :character Median :22.00 Median :2.000
## Mean :166682 Mean :25.19 Mean :1.602
## 3rd Qu.:249627 3rd Qu.:29.00 3rd Qu.:2.000
## Max. :334161 Max. :99.00 Max. :2.000
## agreeable_score extraversion_score openness_score conscientiousness_score
## Min. :0.2000 Min. :0.2000 Min. :0.2533 Min. :0.2067
## 1st Qu.:0.6400 1st Qu.:0.6000 1st Qu.:0.6733 1st Qu.:0.6300
## Median :0.7033 Median :0.6800 Median :0.7367 Median :0.7067
## Mean :0.6968 Mean :0.6723 Mean :0.7339 Mean :0.7020
## 3rd Qu.:0.7633 3rd Qu.:0.7500 3rd Qu.:0.7967 3rd Qu.:0.7767
## Max. :1.0000 Max. :0.9933 Max. :0.9967 Max. :1.0000
## neuroticism_score
## Min. :0.1967
## 1st Qu.:0.4867
## Median :0.5700
## Mean :0.5744
## 3rd Qu.:0.6600
## Max. :0.9967
sapply(bigFiveData, class)
## case_id country age
## "integer" "character" "integer"
## sex agreeable_score extraversion_score
## "integer" "numeric" "numeric"
## openness_score conscientiousness_score neuroticism_score
## "numeric" "numeric" "numeric"
Vidimo iz prioloženog tip podataka danih varijabli. Zemlja je zadana stringom, dok su ostale varijable brojčane(int ili numeric). Svi faktori koje promatramo su numeric tipa i imaju vrijednost od 0 do 1.
Sada gledamo postoje li u našem skupu podataka nedostajuće vrijednosti jer one mogu poremetiti rezultate testa. Promatramo sve varijable i brojimo koliko je NA vrijednosti ako ih ima.
for (col_name in names(bigFiveData)){
if (sum(is.na(bigFiveData[,col_name])) > 0){
cat('Ukupno nedostajućih vrijednosti za varijablu ',col_name, ': ', sum(is.na(bigFiveData[,col_name])),'\n')
}
}
Po rezultatima vidimo da nemamo NA vrijednosti(neodostajućih) ni u jednoj varijabli. Podaci su uredni.
Promotrimo sada kako izgledaju varijable koje dobijemo kao informaciju od ispitanika (godine, zemlja, spol)
Prov ćemo gledati godine jer je to numerička:
hist(bigFiveData$age,main='Age', xlab='Age', ylab='Frequency')
Vidimo da rezultat nije normalne dristirbucije, pa ćemo pokušati log transformacijom približiti normalnoj.
hist(log(bigFiveData$age),main='Age',xlab='Age',ylab='Frequency', breaks=50)
Vidimo da smo se uspjeli približiti normalnoj razdiobi.
Sad ćemo pogledati kategorijske varijable (spol i država)
#broj Muskih i Zenskih ispitanika
print("Podjela na M i Z: ")
## [1] "Podjela na M i Z: "
table(bigFiveData$sex)
##
## 1 2
## 122164 185149
barplot(table(bigFiveData$sex), las=2, main='Sex')
table(bigFiveData$country)
##
## Afghanista Albania Algeria Andorra Angola Anguilla
## 172 624 527 360 167 97 83
## Antarctica Antigua Arabian Gu Argentina Armenia Aruba Australia
## 74 36 32 235 40 23 10400
## Austria Azerbaijan Bahamas Bahrain Bangladesh Barbados Belarus
## 223 47 83 42 63 57 33
## Belgium Belize Benin Bermuda Bhutan Bolivia Borneo
## 663 26 7 35 13 33 11
## Bosnia Her Botswana Bouvet Isl Brazil British In British Vi Brunei
## 77 10 3 661 21 60 22
## Bulgaria Burkina Fa Burma Burma(Myan Burundi Cambodia Cameroon
## 176 6 6 18 7 19 26
## Canada Cape Verde Cayman Isl Central Af Chad Chile China
## 21798 66 63 19 8 81 915
## Christmas Cocos (Kee Columbia Comoros Congo Cook Islan Costa Rica
## 3 4 209 4 6 5 75
## Croatia Cuba Cyprus Czech Repu Denmark Djibouti Dominica
## 307 76 77 108 614 5 10
## Dominican East Timor Ecuador Egypt El Salvado Equatorial Eritrea
## 75 2 56 286 47 1 4
## Estonia Ethiopia Faeroe Isl Falkland I Fiji Finland France
## 189 27 8 4 17 1853 854
## French Gui French Pol Gabon Gambia Georgia Germany Ghana
## 7 8 4 5 30 1167 32
## Gibraltar Greece Greenland Grenada Guadeloupe Guam Guatemala
## 17 653 7 11 3 36 44
## Guinea Guinea-Bis Guyana Haiti Honduras Hong Kong Hungary
## 2 1 21 31 36 750 129
## Iceland India Indonesia Iran Iraq Ireland Israel
## 159 2841 257 117 25 2102 515
## Italy Ivory Coas Jamaica Japan Johnston I Jordan Kazakhstan
## 454 10 129 398 3 82 16
## Kenya Kuwait Kyrgystan Lao P.Dem. Latvia Lebanon Lesotho
## 90 52 6 5 190 159 4
## Liberia Libyan Ara Liechtenst Lithuania Luxembourg Macau Macedonia
## 6 3 1 118 26 19 28
## Madagascar Malawi Malaysia Maldives Mali Malta Marshall I
## 4 3 911 12 2 108 3
## Martinique Mauritania Mauritius Mexico Micronesia Moldova Monaco
## 6 1 30 700 6 12 4
## Mongolia Montserrat Morocco Mozambique Namibia Nepal Netherland
## 5 1 26 3 20 37 3469
## New Caledo New Zealan Nicaragua Niger Nigeria Niue Norfolk Is
## 13 2016 33 9 93 4 5
## North Kore Northern M Norway Oman Pakistan Palau Panama
## 4 10 1058 17 296 5 42
## Papua New Paraguay Peru Philippine Pitcairn I Poland Portugal
## 6 11 109 2488 3 411 455
## Puerto Ric Qatar Republic o Reunion Romania Russian Fe Rwanda
## 218 13 5 3 577 366 5
## Saint Hele Saint Kitt Samoa San Marino Saudi Arab Senegal Serbia
## 2 3 5 1 98 5 169
## Seychelles Sierra Leo Singapore Slovakia Slovenia Solomon Is Somalia
## 7 5 2450 93 178 4 8
## South Afri South Kore Spain Sri Lanka St Lucia St Vincent Sudan
## 927 446 417 62 15 8 12
## Suriname Svalbard & Swaziland Sweden Switzerlan Syria Taiwan
## 4 2 4 1352 217 24 248
## Tanzania Thailand Togo Tokelau Tonga Trinidad a Tunisia
## 14 2059 8 2 4 158 12
## Turkey Turkmenist Turks and Tuvalu Uganda UK Ukraine
## 396 7 21 11 120 16489 179
## United Ara Uruguay USA Uzbekistan Vanuatu Vatican Vatican Ci
## 196 45 212625 20 7 2 6
## Venezuela Vietnam Virgin Isl W. Samoa Wake Islan Wallis and Western Sa
## 126 127 14 1 3 2 1
## Yemen Yugoslavia Zaire Zambia Zimbabwe
## 6 178 2 10 55
barplot(table(bigFiveData$country),cex.names = .25, main="Nationality")
Sada kad smo pregledali podatke koje imamo, možemo krenuti na testiranje hipoteza.
5.TEST
U posljednjem testu promatrat ćemo varijablu dobi (starosti) i uspoređivati ju sa svih 5 faktora koje ispitujemo. Prvo ćemo vidjeti povezanost dobi sa svim tim faktorima, nakon čega ćemo izabrati jedan na kojem ćemo raditi linearnu regresiju te na temelju tog faktora pokušati odrediti dob ispitanika.
Pa krenimo s testiranjem. Za početak ćemo podijeliti varijablu dobi, koja je numerička, na kategorije: mlađi(0-15 godina), srednje dobi(16-30 godina) i starije(30+ godina)..
young = bigFiveData[which(bigFiveData$age <= 15),]
middle = bigFiveData[which(bigFiveData$age > 15 & bigFiveData$age <= 30),]
old = bigFiveData[which(bigFiveData$age > 30),]
Nakon te podjele, gledat ćemo srednje vrijednosti pojedinog faktora i prikazivat ćemo box plotove, na temelju ćega ćemo zaključiit koji je faktor najpovezaniji s dobi i nastaviti raditi s njim linearnu regresiju.
EKTROVERZIJA
cat('Prosječna ocjena ekstraverzije mladih ljudi iznosi ', mean(young$extraversion_score), '\n')
## Prosječna ocjena ekstraverzije mladih ljudi iznosi 0.6924383
cat('Prosječna ocjena ekstraverzije srednjih ljudi iznosi ', mean(middle$extraversion_score), '\n')
## Prosječna ocjena ekstraverzije srednjih ljudi iznosi 0.6774276
cat('Prosječna ocjena ekstraverzije starijih ljudi iznosi ', mean(old$extraversion_score), '\n')
## Prosječna ocjena ekstraverzije starijih ljudi iznosi 0.6503976
boxplot(young$extraversion_score, middle$extraversion_score, old$extraversion_score,
names = c('Young people extraversion score','Middle aged people extraversion score', 'Old people extraversion score'),
main = 'Boxplot of young, middle aged and old people extraversion score')
UGODNOST
cat('Prosječna ocjena ugodnosti mladih ljudi iznosi ', mean(young$agreeable_score), '\n')
## Prosječna ocjena ugodnosti mladih ljudi iznosi 0.6671362
cat('Prosječna ocjena ugodnosti srednjih ljudi iznosi ', mean(middle$agreeable_score), '\n')
## Prosječna ocjena ugodnosti srednjih ljudi iznosi 0.6918796
cat('Prosječna ocjena ugodnosti starijih ljudi iznosi ', mean(old$agreeable_score), '\n')
## Prosječna ocjena ugodnosti starijih ljudi iznosi 0.7210159
boxplot(young$agreeable_score, middle$agreeable_score, old$agreeable_score,
names = c('Young people agreeable score','Middle aged people agreeable score', 'Old people agreeable score'),
main = 'Boxplot of young, middle aged and old people agreeable score')
SAVJESNOST
cat('Prosječna ocjena savjesnosti mladih ljudi iznosi ', mean(young$conscientiousness_score), '\n')
## Prosječna ocjena savjesnosti mladih ljudi iznosi 0.6476224
cat('Prosječna ocjena savjesnosti srednjih ljudi iznosi ', mean(middle$conscientiousness_score), '\n')
## Prosječna ocjena savjesnosti srednjih ljudi iznosi 0.6936849
cat('Prosječna ocjena savjesnosti starijih ljudi iznosi ', mean(old$conscientiousness_score), '\n')
## Prosječna ocjena savjesnosti starijih ljudi iznosi 0.7441107
boxplot(young$conscientiousness_score, middle$conscientiousness_score, old$conscientiousness_score,
names = c('Young people conscientiousness score','Middle aged people conscientiousness score', 'Old people conscientiousness score'),
main = 'Boxplot of young, middle aged and old people conscientiousness score')
NEUROTICIZAM
cat('Prosječna ocjena neuroticizma mladih ljudi iznosi ', mean(young$neuroticism_score), '\n')
## Prosječna ocjena neuroticizma mladih ljudi iznosi 0.5960167
cat('Prosječna ocjena neuroticizma srednjih ljudi iznosi ', mean(middle$neuroticism_score), '\n')
## Prosječna ocjena neuroticizma srednjih ljudi iznosi 0.5797046
cat('Prosječna ocjena neuroticizma starijih ljudi iznosi ', mean(old$neuroticism_score), '\n')
## Prosječna ocjena neuroticizma starijih ljudi iznosi 0.5513757
boxplot(young$neuroticism_score, middle$neuroticism_score, old$neuroticism_score,
names = c('Young people neuroticism score','Middle aged people neuroticism score', 'Old people neuroticism score'),
main = 'Boxplot of young, middle aged and old people neuroticism score')
OTVORENOST NOVIM ISKUSTVIMA
cat('Prosječna ocjena otvorenosti mladih ljudi iznosi ', mean(young$openness_score), '\n')
## Prosječna ocjena otvorenosti mladih ljudi iznosi 0.7281298
cat('Prosječna ocjena otvorenosti srednjih ljudi iznosi ', mean(middle$openness_score), '\n')
## Prosječna ocjena otvorenosti srednjih ljudi iznosi 0.7343365
cat('Prosječna ocjena otvorenosti starijih ljudi iznosi ', mean(old$openness_score), '\n')
## Prosječna ocjena otvorenosti starijih ljudi iznosi 0.7344109
boxplot(young$openness_score, middle$openness_score, old$openness_score,
names = c('Young people openness score','Middle aged people openness score', 'Old people openness score'),
main = 'Boxplot of young, middle aged and old people openness score')
Nakon što smo pogledali prosjeke i napravili box plotove, bez računanja testova za svaki faktor posebno, možemo vidjeti da je savjesnost najviše ovisna o dobi. Zbog toga sada biramo savjesnost i radimo daljnja testiranja za dob vs savjesnost ispitanika.
Prije svakog testiranja gdje pretpostavljamo normalnost, moramo ju pokazati. Za početak ćemo prikazati podatke u histogramu.
Histogram za savjesnost mlađih:
hist(young$conscientiousness_score, main='Younger people conscientiousness score', xlab='Conscientiousness score', ylab='Frequency')
Histogram za savjesnost srednjh:
hist(middle$conscientiousness_score, main='Middle aged people conscientiousness score', xlab='Conscientiousness score', ylab='Frequency')
Histogram za savjesnost starijih:
hist(old$conscientiousness_score, main='Older people conscientiousness score', xlab='Conscientiousness score', ylab='Frequency')
Nakon što smo napravili histograme na kojima odokativno možemo vidjeti da se radi o normalno distribuiranim podacima, napraviti ćemo i plotove da vidimo postoje li outlieri.
Na danom box-plotu vidimo da postoje outlieri, te ćemo zbog jednostavnosti i zbog prestpostavke normalnosti ukloniit te outliere.
Uklanjanje outliera za “young” ispitanike u stupcu za savjesnost:
Q1 <- quantile(young$conscientiousness_score, .25)
Q3 <- quantile(young$conscientiousness_score, .75)
IQR <- IQR(young$conscientiousness_score)
no_outliers_young <- subset(young, young$conscientiousness_score> (Q1 - 1.5*IQR) & young$conscientiousness_score< (Q3 + 1.5*IQR))
Uklanjanje outliera za “middle” ispitanike u stupcu za savjesnost:
Q1 <- quantile(middle$conscientiousness_score, .25)
Q3 <- quantile(middle$conscientiousness_score, .75)
IQR <- IQR(middle$conscientiousness_score)
no_outliers_middle <- subset(middle, middle$conscientiousness_score> (Q1 - 1.5*IQR) & middle$conscientiousness_score< (Q3 + 1.5*IQR))
Uklanjanje outliera za “old” ispitanike u stupcu za savjesnost:
Q1 <- quantile(old$conscientiousness_score, .25)
Q3 <- quantile(old$conscientiousness_score, .75)
IQR <- IQR(old$conscientiousness_score)
no_outliers_old <- subset(old, old$conscientiousness_score> (Q1 - 1.5*IQR) & old$conscientiousness_score< (Q3 + 1.5*IQR))
dim(no_outliers_old)
## [1] 68768 9
dim(old)
## [1] 69298 9
Pokušavamo ponovno box plot napraviti kada smo(izbacili outliere?):
boxplot(no_outliers_young$conscientiousness_score, no_outliers_middle$conscientiousness_score, no_outliers_old$conscientiousness_score,
names = c('Young people conscientiousness score','Middle aged people conscientiousness score', 'Old people conscientiousness score'),
main = 'Boxplot of young, middle aged and old people conscientiousness score')
Prosjeci ekstroverzije:
Histogram za ekstraverziju mlađih:
hist(young$extraversion_score, main='Younger people extraversion score', xlab='Extraversion score', ylab='Frequency')
Histogram za ekstraverziju mlađih:
hist(middle$extraversion_score, main='Middle people extraversion score', xlab='Extraversion score', ylab='Frequency')
Histogram za ekstraverziju starijih:
hist(old$extraversion_score, main='Older people extraversion score', xlab='Extraversion score', ylab='Frequency')
Na prethodnim histogramima možemo “na oko” vidjeti da se radi o normalnoj distibuciji, ali ćemo svakako provesti test za dokazeivanje normalnosti da budemo sigurniji.
Sada radimo Lilliefors test:
LINEARNA REGRESIJA Nakon provedenih 5 testova gdje smo uspoređivali dob sa svakim od 5 faktora odlučili smo se testirati početno, tj vidjeti možemo li na temelju dobi odrediti savjesnost.
Kad promatramo utjecaj samo jedne nezavisne varijable X na neku zavisnu varijablu Y, grafički je moguće dobiti jako dobar dojam o njihovom odnosu - tu je najčešće od pomoći scatter plot. Zbog toga ćemo prikazati te podatke na scatter plotu.
Scatter plot za dob vs otvorenost prema novim iskustvima:
plot(bigFiveData$openness_score, bigFiveData$age)
Scatter plot za dob vs ekstrovertiranost:
plot(bigFiveData$extraversion_score, bigFiveData$age)
Scatter plot za dob vs ugodnost:
plot(bigFiveData$agreeable_score, bigFiveData$age)
Scatter plot za dob vs savjesnost:
plot(bigFiveData$conscientiousness_score, bigFiveData$age)
Scatter plot za dob vs neurotizicizam:
plot(bigFiveData$neuroticism_score, bigFiveData$age)
Sada ćemo napraviti linearni model za svih tih 5 primjera.
Linearni modeli:
fit.opennes = lm(age~openness_score,data=bigFiveData)
fit.extraversion = lm(age~extraversion_score,data=bigFiveData)
fit.agreeable = lm(age~agreeable_score,data=bigFiveData)
fit.conscientiousness = lm(age~conscientiousness_score,data=bigFiveData)
fit.neuroticism = lm(age~neuroticism_score,data=bigFiveData)
Sada crtamo liniju linearne regresije za sve ove modele:
Dob vs otvorenost:
plot(bigFiveData$openness_score, bigFiveData$age) #graficki prikaz podataka
lines(bigFiveData$openness_score,fit.opennes$fitted.values,col="red") #linija
Dob vs ekstroverzija:
plot(bigFiveData$extraversion_score, bigFiveData$age) #graficki prikaz podataka
lines(bigFiveData$extraversion_score,fit.extraversion$fitted.values,col="red") #linija
Dob vs ugodnost:
plot(bigFiveData$agreeable_score, bigFiveData$age) #graficki prikaz podataka
lines(bigFiveData$agreeable_score,fit.agreeable$fitted.values,col="red") #linija
Dob vs savjesnost:
plot(bigFiveData$conscientiousness_score, bigFiveData$age) #graficki prikaz podataka
lines(bigFiveData$conscientiousness_score,fit.conscientiousness$fitted.values,col="red") #linija
Dob vs neuroticizam:
plot(bigFiveData$neuroticism_score, bigFiveData$age) #graficki prikaz podataka
lines(bigFiveData$neuroticism_score,fit.neuroticism$fitted.values,col="red") #linija
Nakon što smo napravili 5 scatter plotova s regresijskim linijama, vidimo da najviše smisla ima uspoređivati dob sa savjesnošću. Napravili smo 5 scatter plotova za svaki od 5 faktora uspoređujući ga s dobi, i nakon toga smo napravili još 5 s regresijskom linijom. U skupu imamo previše podataka zbog čega scatter plotovi nisu pregledni, ali kada postavimo regresijsku liniju, možemo odokativno nešto i zaključiti.
Sada treba provjeriti da pretpostavke modela nisu (jako) narušene. Pritom su najbitnije pretpostavke o regresorima i o rezidualima (normalnost reziduala i homogenost varijance).
Normalnost reziduala provjerit ćemo grafički, pomoću q-q plota te statistički pomoću Kolmogorov-Smirnovljevog testa
selected.model = fit.conscientiousness
plot(selected.model$residuals)
Histogram:
hist((selected.model$residuals))
hist(rstandard(selected.model))
Q-Q plot:
#q-q plot reziduala s linijom normalne distribucije
qqnorm(rstandard(selected.model))
qqline(rstandard(selected.model))
plot(selected.model$fitted.values,selected.model$residuals)
Kolmogorov Smirnovljev test:
ks.test(rstandard(fit.conscientiousness),"pnorm")
## Warning in ks.test(rstandard(fit.conscientiousness), "pnorm"): ties should not
## be present for the Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: rstandard(fit.conscientiousness)
## D = 0.13807, p-value < 2.2e-16
## alternative hypothesis: two-sided
require(nortest)
## Loading required package: nortest
Lillieforsov test:
lillie.test(rstandard(fit.conscientiousness))
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: rstandard(fit.conscientiousness)
## D = 0.13807, p-value < 2.2e-16